home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / utils / ted / tedtro10.pas < prev    next >
Pascal/Delphi Source File  |  1994-10-02  |  7KB  |  240 lines
  1. {
  2.                           Coding & Editing by :
  3.         █▀▀▀▀▀▀█ █▀▀▀▀▀▀█ █▀▀▀▀▀▀█ █▀▀▀▀▀▀█ █▀▀▀▀▀█ █ █▀▀▀▀▀▀▀ █▀▀▀▀▀▀▀
  4.         █▀▀▀▀▀▀▀ █▀▀▀▀▀▀█ █▀▀▀▀▀█▀ █▀▀▀▀▀▀█ █     █ █ ▀▀▀▀▀▀▀█ █▀▀▀▀▀
  5.         █        █      █ █      █ █      █ █     █ █        █ █
  6.         █        █      █ █      █ █      █ █     █ █        █ █
  7.         █        █      █ █      █ █      █ █     █ █        █ █
  8.         █        █      █ █      █ █      █ █▄▄▄▄▄█ █ ▄▄▄▄▄▄▄█ █▄▄▄▄▄▄▄
  9.  
  10.         Programmed by Marcin Jaskowiak, aka Paradise, Lublin, Poland,
  11.                           in Turbo Pascal 7.0.
  12.  
  13.         This is FUQNWARE - if u like it, u must register it by sending
  14.         some money (u tell how much) to ME:) if not - u choose.
  15.         Read TED.DOC 4 more info.
  16.  
  17.         Snail mail:                      Email:
  18.         Marcin Jaskowiak                 liksay@bachus.umcs.lublin.pl
  19.         Flat 114, 3 Zarnowiecka Str.
  20.         20-630 Lublin
  21.         Poland
  22.  
  23.                                Presents :
  24.                     TED font editor SCROLLERS PACK 94
  25.                                 with :
  26.                              EXAMPLE NR 10
  27. }
  28. PROGRAM TED_INTRO_NR10;
  29. USES DOS,CRT;
  30.  
  31. CONST
  32.  SEGA000        : WORD = $A000;
  33.  SCR_OFS        : WORD = 22400;
  34. VAR
  35.  BITMAP         : ARRAY [1..60,0..319] OF BYTE;
  36.  PALETTE        : ARRAY [0..255,1..3] OF BYTE;
  37.  CHARS          : ARRAY [' '..']'] OF POINTER;
  38.  CHARSDATA      : ARRAY [' '..']',1..3] OF BYTE;
  39.  F              : FILE;
  40.  B,ROW,NR       : BYTE;
  41.  X,Y,I          : INTEGER;
  42.  CH,K           : CHAR;
  43.  TEKST          : STRING;
  44.  PAL            : ARRAY [0..26] OF BYTE;
  45.  
  46. {───────────────────────────────────────────────────────────────────────────}
  47. PROCEDURE INITVGA; ASSEMBLER; { INITIALIZE VGA CARD MODE 13H }
  48. ASM
  49.  MOV AX,0013H
  50.  INT 10H
  51. END;
  52. {───────────────────────────────────────────────────────────────────────────}
  53. PROCEDURE CLOSEVGA; ASSEMBLER; { CLOSE VGA MODE AND SET TEXT }
  54. ASM
  55.  MOV AX,0003H
  56.  INT 10H
  57. END;
  58. {───────────────────────────────────────────────────────────────────────────}
  59. PROCEDURE VSYNC; ASSEMBLER;
  60. ASM
  61.  MOV DX,03DAH
  62.  @L1: IN AL,DX; TEST AL,8; JNZ @L1;
  63.  @L2: IN AL,DX; TEST AL,8; JZ  @L2;
  64. END;
  65. {───────────────────────────────────────────────────────────────────────────}
  66. PROCEDURE DRAWBITMAP; ASSEMBLER;
  67. ASM
  68.  MOV DI,SCR_OFS
  69.  MOV ES,SEGA000
  70.  MOV SI,OFFSET BITMAP
  71.  MOV CX,9600
  72.  CLD
  73.  REP MOVSW
  74. END;
  75. {───────────────────────────────────────────────────────────────────────────}
  76. PROCEDURE SCROLLBITMAP(VAR MAP); ASSEMBLER;
  77. ASM
  78.   LDS SI,MAP
  79.   LES DI,MAP
  80.   INC SI
  81.   INC SI
  82.   INC SI
  83.   MOV CX,9600
  84.   REP MOVSW
  85. END;
  86. {───────────────────────────────────────────────────────────────────────────}
  87. PROCEDURE SETCOLOR(NR,R,G,B: BYTE); ASSEMBLER; { SET RGB VAL TO COLOR NR }
  88. ASM
  89.  MOV DX,3C8H
  90.  MOV AL,NR
  91.  OUT DX,AL
  92.  INC DX
  93.  MOV AL,R
  94.  OUT DX,AL
  95.  MOV AL,G
  96.  OUT DX,AL
  97.  MOV AL,B
  98.  OUT DX,AL
  99. END;
  100. {───────────────────────────────────────────────────────────────────────────}
  101. PROCEDURE LOADPAL(NAME: STRING); { LOAD .PAL FILE AND SET PALETTE }
  102. BEGIN
  103.  ASSIGN(F,NAME+'.PAL');
  104.  RESET(F,1);
  105.  BLOCKREAD(F,PALETTE,768);
  106.  CLOSE(F);
  107.  FOR B:=0 TO 255 DO SETCOLOR(B,PALETTE[B,1],PALETTE[B,2],PALETTE[B,3]);
  108. END;
  109. {───────────────────────────────────────────────────────────────────────────}
  110. PROCEDURE LOADTED(NAME: STRING); { LOAD .TED FILE TO MEMORY }
  111. VAR TX,TY: BYTE; CH: CHAR;
  112. BEGIN
  113.  ASSIGN(F,NAME+'.TED');
  114.  RESET(F,1);
  115.  SEEK(F,20);
  116.  WHILE NOT(EOF(F)) DO
  117.  BEGIN
  118.   BLOCKREAD(F,CH,1);
  119.   BLOCKREAD(F,TX,1);
  120.   BLOCKREAD(F,TY,1);
  121.   GETMEM(CHARS[CH],TX*TY);
  122.   CHARSDATA[CH,1]:=TX; CHARSDATA[CH,2]:=TY; CHARSDATA[CH,3]:=1;
  123.   BLOCKREAD(F,CHARS[CH]^,TX*TY);
  124.  END;
  125.  IF CHARSDATA[' ',3]<>1 THEN { IF NOT SPACE " " THEN CREATE IT }
  126.  BEGIN
  127.   TX:=CHARSDATA['A',1];
  128.   TY:=CHARSDATA['A',2];
  129.   GETMEM(CHARS[' '],TX*TY);
  130.   FILLCHAR(CHARS[' ']^,TX*TY,0);
  131.   CHARSDATA[' ',3]:=1;
  132.   CHARSDATA[' ',1]:=TX;
  133.   CHARSDATA[' ',2]:=TY;
  134.  END;
  135.  CLOSE(F);
  136. END;
  137. {───────────────────────────────────────────────────────────────────────────}
  138. PROCEDURE DONETED; { DEALLOCATE FONT MEMORY }
  139. VAR CH: CHAR;
  140. BEGIN
  141.  FOR CH:=' ' TO ']' DO
  142.  BEGIN
  143.   IF CHARSDATA[CH,3]=1 THEN
  144.   BEGIN
  145.    FREEMEM(CHARS[CH],CHARSDATA[CH,1]*CHARSDATA[CH,2]);
  146.    CHARSDATA[CH,3]:=0;
  147.   END;
  148.  END;
  149. END;
  150. {───────────────────────────────────────────────────────────────────────────}
  151. PROCEDURE NEWROW(CH: CHAR; RO: BYTE; POS: INTEGER); { DRAW HORIZ LINE }
  152. VAR II,TX,TY: INTEGER;
  153. BEGIN
  154.  IF CHARSDATA[CH,3]<>1 THEN EXIT;
  155.  IF RO=CHARSDATA[CH,1]+1 THEN
  156.   FOR TY:=1 TO CHARSDATA[CH,2] DO BITMAP[TY,POS]:=226
  157.  ELSE
  158.   FOR TY:=1 TO CHARSDATA[CH,2] DO
  159.   BITMAP[TY,POS]:=MEM[SEG(CHARS[CH]^):OFS(CHARS[CH]^)+(TY-1)*CHARSDATA[CH,1]+RO-1];
  160. END;
  161. {───────────────────────────────────────────────────────────────────────────}
  162. PROCEDURE UPDATE; { NEW VALUES ? }
  163. BEGIN
  164.  INC(ROW);
  165.  IF ROW>CHARSDATA[TEKST[NR],1]+1 THEN
  166.  BEGIN
  167.   ROW:=1;
  168.   INC(NR);
  169.   IF NR>LENGTH(TEKST) THEN NR:=1;
  170.  END;
  171. END;
  172. {───────────────────────────────────────────────────────────────────────────}
  173. PROCEDURE MUTEFONT; { THIS PROC DR4W BACKGROUND ON ALL POSSIBLE CHARS }
  174. VAR AX,AY: INTEGER; CH: CHAR;
  175. BEGIN
  176.  FOR CH:=' ' TO ']' DO
  177.  IF CHARSDATA[CH,3]=1 THEN
  178.  BEGIN
  179.   FOR AY:=0 TO CHARSDATA[CH,2]-1 DO
  180.   FOR AX:=0 TO CHARSDATA[CH,1]-1 DO
  181.   BEGIN
  182.    IF MEM[SEG(CHARS[CH]^):OFS(CHARS[CH]^)+AY*CHARSDATA[CH,1]+AX]=0 THEN
  183.    MEM[SEG(CHARS[CH]^):OFS(CHARS[CH]^)+AY*CHARSDATA[CH,1]+AX]:=200+AX;
  184.   END;
  185.  END;
  186. END;
  187. {───────────────────────────────────────────────────────────────────────────}
  188. PROCEDURE SETFPAL;
  189. VAR B: BYTE;
  190. BEGIN
  191.  FOR B:=0 TO 26 DO SETCOLOR(200+B,0,PAL[B],0);
  192. END;
  193. {───────────────────────────────────────────────────────────────────────────}
  194. PROCEDURE SBAR;
  195. VAR MM: BYTE;
  196. BEGIN
  197.  MM:=12;
  198.  FILLCHAR(PAL,27,0);
  199.  FOR I:=1 TO MM DO
  200.  BEGIN
  201.   PAL[I]:=15+I*2;
  202.   PAL[MM*2-I]:=15+I*2;
  203.  END;
  204. END;
  205. PROCEDURE BAR;
  206. VAR B: BYTE;
  207. BEGIN
  208.  B:=PAL[0];
  209.  MOVE(PAL[1],PAL[0],26);
  210.  PAL[26]:=B;
  211. END;
  212. {───────────────────────────────────────────────────────────────────────────}
  213.  
  214.  
  215.  
  216. BEGIN
  217.  INITVGA;
  218.  LOADPAL('FONT010');
  219.  LOADTED('FONT010');
  220.  MUTEFONT;
  221.  ROW:=1;
  222.  TEKST:='  OK.. NOW TIME TO SOME BACKGROUND EFFECT...  BACKGROUND BARS...  ## OFCOZ PALETTE ROTATION! .. :-]             ';
  223.  NR:=1;
  224.  SBAR;
  225.  REPEAT
  226.   SCROLLBITMAP(BITMAP);
  227.   UPDATE;
  228.   NEWROW(TEKST[NR],ROW,317);
  229.   UPDATE;
  230.   NEWROW(TEKST[NR],ROW,318);
  231.   UPDATE;
  232.   NEWROW(TEKST[NR],ROW,319);
  233.   DRAWBITMAP;
  234.   VSYNC;
  235.   BAR;
  236.   SETFPAL;
  237.  UNTIL KEYPRESSED;
  238.  DONETED;
  239.  CLOSEVGA;
  240. END.